perm filename GEN.F4[JC,MUS] blob sn#080819 filedate 1974-01-09 generic text, type C, neo UTF8
COMMENT āŠ—   VALID 00002 PAGES
C REC  PAGE   DESCRIPTION
C00001 00001
C00002 00002
C00004 ENDMK
CāŠ—;

	SUBROUTINE GEN(FUN)
C  AFTER 'SYNTH(F1);'  TYPE 99= TO USE  H,A,P,K: ALL OTHER
C   NUMBERS = H,A ONLY.  TYPE 999 TO END. NORMALIZATION IS AUTOMATIC.
	DIMENSION FUN(50)
	COMMON FREQ(3,0/50,50),FUNC(50),AMP(50),II(1),IJJ(3000)
3002	TYPE 1002
1002	FORMAT(' 0 TO CLEAR ELSE 1'/)
	ACCEPT 201,AB
	IF(AB.NE.0.0)GO TO 1001
	DO 15 I=1,50
15	FUN(I)=0.0
201	FORMAT(4F)
1001	FAC=360./50.
16	CALL DPYSET(1,IJJ,3000)
	CALL ALINE(0,0,200,0)
	CALL ALINE(0,100,0,0)
	TYPE 445
445	FORMAT(' TYPE H,A,P,K OR 999'/)
	ACCEPT 201,H,AMPL,X,CON
	IF(H.EQ.999.)GO TO 446
	X=X*50./360.	
2016	DO 17 J=1,50
	XK=SIND(X*FAC)*AMPL+CON
	IF(CON.LT.100.0)GO TO 1
	FUN(J)=(XK-100.)*FUN(J)
	GO TO 2
1	FUN(J)=FUN(J)+XK
2	X=X+H
	IY=FUN(J)*100.
	IX=J*4
	CALL AVECT(IX,IY)
	IF(X.LE.50.)GO TO 17
	X=X-50.
17	CONTINUE
	CALL DPYOUT(1)
	GO TO 16
446	CALL DPYSET(1,IJJ,3000)
	CALL ALINE(0,0,200,0)
	CALL ALINE(0,100,0,0)
2200	X=FUN(1)
	DO 19 I=2,50
	H=ABS(FUN(I))
19	IF(X.LT.H)X=H
	DO 20 I=1,50
	FUN(I)=FUN(I)/X
	IY=FUN(I)*100.
	IX=(I-1)*4
20	CALL AVECT(IX,IY)
	CALL DPYOUT(1)
	PAUSE
	CALL HYDPOG(1)
	RETURN
	END